home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
COMAL
/
B-Book Series
/
(k)b2.d64
/
entermarks
< prev
next >
Wrap
Text File
|
2007-02-28
|
3KB
|
141 lines
0010 //OLDHAM'S GRAMMAR SCHOOL//
0020 //PROGRAM TO ADMINISTER PUPILS' MARKS//
0030 //WRITTEN BY CHRIS BORGE IN CBM COMAL-80//
0040 //THIS VERSION: OCT. 1981//
0050 //THIS PART: TO ENTER PUPILS' MARKS//
0060 //
0070 MAX:=8
0080 DIM NAME$(MAX) OF 20, ANSW$ OF 11
0090 DIM MARK(MAX,3), SUBJ$(3) OF 11, KEY'(MAX)
0100 DIM SPACES$ OF 39
0105 //*
0110 SUBJ$(1):="ENGLISH"
0130 SUBJ$(2):="MATHEMATICS"
0140 SUBJ$(3):="FRENCH"
0150 SPACES$(1:39):=""
0180 //
0190 STARTSYSTEM
0200 //
0210 //* MAINLINES *//
0220 SUBJNO:=0
0230 REPEAT
0240 PRINT CHR$(147) //CLEAR SCREEN
0250 FIELD(8,15)
0260 PRINT "1=ENTER MARKS"
0270 PRINT "2=LIST MARKS"
0280 PRINT "3=STOP PROGRAM"
0290 PRINT
0300 INPUT "> ": JOBCODE
0310 IF JOBCODE=1 THEN ENTERMARKS
0320 IF JOBCODE=2 THEN PRINTOUT
0330 IF JOBCODE=3 THEN STOPSYSTEM
0340 UNTIL FALSE //FOREVER
0350 //
0360 PROC ENTERMARKS
0370 TAKEIN("CLASS")
0380 TAKEIN("SUBJECT")
0390 PRINT CHR$(147) //CLEAR SCREEN
0400 PRINT "YOU MAY NOW ENTER PUPILS' MARKS"
0405 PRINT "IN ",SUBJ$(SUBJNO)
0410 PRINT
0420 FOR PUPILNO:=1 TO MAX DO
0430 IF NAME$(PUPILNO)<>"" THEN
0440 TAKEIN("MARK")
0450 ENDIF
0460 ENDFOR PUPILNO
0470 ENDPROC ENTERMARKS
0480 //
0490 PROC TAKEIN(MATTER$)
0500 REPEAT
0510 FIELD(8,15)
0520 CASE MATTER$ OF
0530 WHEN "CLASS"
0540 INPUT "CLASS (8,9,10): ": CLASS
0550 WHEN "SUBJECT"
0560 PRINT "ENTER NAME OF SUBJECT:"
0570 PRINT "(ENGLISH, MATHEMATICS, FRENCH)",
0580 INPUT "> ": ANSW$
0590 WHEN "MARK"
0600 PRINT NAME$(PUPILNO),TAB(30),": ",
0610 INPUT "": THISMARK
0620 ENDCASE
0630 CONTROL
0640 UNTIL OK
0650 PRINT CHR$(147)
0660 ENDPROC TAKEIN
0670 //
0680 PROC CONTROL
0690 CASE MATTER$ OF
0700 WHEN "CLASS"
0710 OK:=(CLASS=8)
0720 LACKING:=(CLASS=9 OR CLASS=10)
0730 WHEN "SUBJECT"
0740 I:=1
0750 WHILE ANSW$<>SUBJ$(I) AND I<3 DO
0754 I:=I+1
0758 ENDWHILE
0760 OK:=ANSW$=SUBJ$(I); SUBJNO:=I
0770 WHEN "MARK"
0780 OK:=(0<=THISMARK AND THISMARK<=5)
0790 IF OK THEN MARK(PUPILNO,SUBJNO):=THISMARK
0800 ENDCASE
0810 IF NOT OK THEN ERROR(4)
0820 ENDPROC CONTROL
0830 //
0840 //
0850 PROC ERROR(NO)
0860 FIELD(1,3)
0870 PRINT "ERROR!"
0880 //
0890 //NOT FINISHED//
0900 //
0910 ENDPROC ERROR
0920 //
0930 //
0940 PROC FIELD(L1,L2)
0950 SCREEN(L1,1)
0960 FOR I:=1 TO L2-L1+1 DO PRINT SPACES$
0970 SCREEN(L1,1)
0980 PRINT
0990 ENDPROC FIELD
1000 //
1010 PROC SCREEN(ROW,COL)
1020 PRINT CHR$(19) //CURSOR HOME
1030 FOR I:=1 TO ROW DO PRINT //DOWN
1035 FOR I:=1 TO COL-1 DO PRINT CHR$(29), //RIGHT
1040 ENDPROC SCREEN
1050 //
1060 PROC STARTSYSTEM
1070 OPEN FILE 2,"MARKBOOKS",READ
1080 FOR PUPILNO:=1 TO MAX DO
1090 READ FILE 2: NAME$(PUPILNO)
1100 FOR SUBJNO:=1 TO 3 DO READ FILE 2: MARK(PUPILNO,SUBJNO)
1110 ENDFOR PUPILNO
1120 CLOSE
1130 ENDPROC STARTSYSTEM
1140 //
1150 PROC STOPSYSTEM
1160 OPEN FILE 2,"@0:MARKBOOKS",WRITE
1170 FOR PUPILNO:=1 TO MAX DO
1180 WRITE FILE 2: NAME$(PUPILNO)
1190 FOR SUBJNO:=1 TO 3 DO WRITE FILE 2: MARK(PUPILNO,SUBJNO)
1200 ENDFOR PUPILNO
1210 CLOSE
1220 STOP
1230 ENDPROC STOPSYSTEM
1240 //
1250 PROC PRINTOUT
1260 IF SUBJNO=0 THEN TAKEIN("SUBJECT")
1270 PRINT CHR$(147) //CLEAR
1280 PRINT "MARKS IN ",SUBJ$(SUBJNO),":"
1290 PRINT
1300 FOR PUPILNO:=1 TO MAX DO
1310 IF NAME$(PUPILNO)<>"" THEN
1320 PRINT PUPILNO,". ",NAME$(PUPILNO),":",TAB(25),
1330 PRINT MARK(PUPILNO,SUBJNO)
1340 ENDIF
1350 ENDFOR PUPILNO
1360 PRINT
1370 INPUT "TYPE RETURN TO CONTINUE ": ANSW$
1380 ENDPROC PRINTOUT